home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / teddy-1a / form3.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-09-21  |  9.4 KB  |  279 lines

  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   0  'None
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   3225
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   4530
  9.    Icon            =   "Form3.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3225
  14.    ScaleWidth      =   4530
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   2  'CenterScreen
  17.    Begin VB.Timer Timer1 
  18.       Interval        =   1
  19.       Left            =   0
  20.       Top             =   0
  21.    End
  22.    Begin VB.Shape Shape13 
  23.       Height          =   315
  24.       Left            =   120
  25.       Top             =   2220
  26.       Width           =   495
  27.    End
  28.    Begin VB.Shape Shape12 
  29.       BackColor       =   &H00400000&
  30.       BackStyle       =   1  'Opaque
  31.       Height          =   195
  32.       Left            =   2580
  33.       Shape           =   2  'Oval
  34.       Tag             =   "1"
  35.       Top             =   1440
  36.       Width           =   195
  37.    End
  38.    Begin VB.Shape Shape11 
  39.       BackColor       =   &H00400000&
  40.       BackStyle       =   1  'Opaque
  41.       Height          =   195
  42.       Left            =   1500
  43.       Shape           =   2  'Oval
  44.       Tag             =   "1"
  45.       Top             =   1440
  46.       Width           =   195
  47.    End
  48.    Begin VB.Shape Shape7 
  49.       BackColor       =   &H00C00000&
  50.       BackStyle       =   1  'Opaque
  51.       Height          =   435
  52.       Left            =   2460
  53.       Shape           =   2  'Oval
  54.       Tag             =   "1"
  55.       Top             =   1200
  56.       Width           =   495
  57.    End
  58.    Begin VB.Shape Shape6 
  59.       BackColor       =   &H00C00000&
  60.       BackStyle       =   1  'Opaque
  61.       Height          =   435
  62.       Left            =   1380
  63.       Shape           =   2  'Oval
  64.       Tag             =   "1"
  65.       Top             =   1200
  66.       Width           =   495
  67.    End
  68.    Begin VB.Shape Shape8 
  69.       BackColor       =   &H00400040&
  70.       BackStyle       =   1  'Opaque
  71.       Height          =   435
  72.       Left            =   1920
  73.       Shape           =   2  'Oval
  74.       Tag             =   "1"
  75.       Top             =   1680
  76.       Width           =   495
  77.    End
  78.    Begin VB.Shape Shape10 
  79.       BackColor       =   &H00000080&
  80.       BackStyle       =   1  'Opaque
  81.       BorderStyle     =   0  'Transparent
  82.       Height          =   1395
  83.       Left            =   1320
  84.       Shape           =   2  'Oval
  85.       Tag             =   "1"
  86.       Top             =   1320
  87.       Width           =   2055
  88.    End
  89.    Begin VB.Shape Shape5 
  90.       BackColor       =   &H000080FF&
  91.       BackStyle       =   1  'Opaque
  92.       Height          =   675
  93.       Left            =   3480
  94.       Shape           =   2  'Oval
  95.       Tag             =   "1"
  96.       Top             =   300
  97.       Width           =   735
  98.    End
  99.    Begin VB.Shape Shape1 
  100.       BackColor       =   &H000080FF&
  101.       BackStyle       =   1  'Opaque
  102.       Height          =   675
  103.       Left            =   300
  104.       Shape           =   2  'Oval
  105.       Tag             =   "1"
  106.       Top             =   300
  107.       Width           =   735
  108.    End
  109.    Begin VB.Shape Shape3 
  110.       BackColor       =   &H00004080&
  111.       BackStyle       =   1  'Opaque
  112.       Height          =   1215
  113.       Left            =   3180
  114.       Shape           =   2  'Oval
  115.       Top             =   0
  116.       Width           =   1335
  117.    End
  118.    Begin VB.Shape Shape9 
  119.       BackColor       =   &H00000000&
  120.       BackStyle       =   1  'Opaque
  121.       Height          =   1395
  122.       Left            =   1260
  123.       Shape           =   2  'Oval
  124.       Tag             =   "1"
  125.       Top             =   1680
  126.       Width           =   2055
  127.    End
  128.    Begin VB.Shape Shape4 
  129.       BackColor       =   &H00000080&
  130.       BackStyle       =   1  'Opaque
  131.       Height          =   2595
  132.       Left            =   660
  133.       Shape           =   2  'Oval
  134.       Top             =   600
  135.       Width           =   3255
  136.    End
  137.    Begin VB.Shape Shape2 
  138.       BackColor       =   &H00004080&
  139.       BackStyle       =   1  'Opaque
  140.       FillColor       =   &H00004080&
  141.       Height          =   1215
  142.       Left            =   0
  143.       Shape           =   2  'Oval
  144.       Top             =   60
  145.       Width           =   1335
  146.    End
  147. Attribute VB_Name = "frmMain"
  148. Attribute VB_GlobalNameSpace = False
  149. Attribute VB_Creatable = False
  150. Attribute VB_PredeclaredId = True
  151. Attribute VB_Exposed = False
  152. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  153. '   ^ used for AlwaysOnTop sub
  154. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  155. Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  156. Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  157. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  158. Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  159. '   ^ sets windows regions
  160. Private Type POINTAPI
  161.     X As Long
  162.     Y As Long
  163. End Type
  164. '   ^ an XY type
  165. Const Shape_Rectange = 0
  166. Const Shape_Square = 1
  167. Const Shape_Oval = 2
  168. Const Shape_Circle = 3
  169. Const Shape_RndRectange = 4
  170. Const Shape_RndSquare = 4
  171. '   ^ shape constants
  172. Const conHwndTopmost = -1
  173. Const conHwndNoTopmost = -2
  174. '   ^ top-most constants
  175. Const RGN_AND = 1
  176. Const RGN_COPY = 5
  177. Const RGN_DIFF = 4
  178. Const RGN_OR = 2
  179. Const RGN_XOR = 3
  180. '   ^ region drawing constants
  181. Public UD As Integer
  182. Public LR As Integer
  183. '   ^ variables used in the bouncing timer
  184. Dim MousePos As POINTAPI
  185. Dp As POINTAPI
  186. '   ^ lets you to use the XY type
  187. Dim DoDrag As Boolean
  188. '   ^ is the teddy being dragged?
  189. Private Sub Form_DblClick()
  190.     Unload Me
  191.     '   ^ exit when double clicked
  192. End Sub
  193. Private Sub Form_KeyPress(KeyAscii As Integer)
  194.     Unload Me
  195.     '   ^ exit when keyboard button is pressed
  196. End Sub
  197. Private Sub Form_Load()
  198.     UD = -60
  199.     LR = -60
  200.     '   ^ sets the initial bounce direction
  201.     AlwaysOnTop True
  202.     '   ^ makes sure no other object can be placed over...
  203.     '     ...the teddy
  204.     Dim t, elipHnd(999999) As Long
  205.     Dim n As Integer, eod As Integer
  206.     '   ^ this bit is the variables needed for auto...
  207.     '     ...drawing the forms new regions.
  208.     n = -1
  209.     eod = 0
  210.     '   ^ sets their default value
  211.     For Each t In frmMain
  212.         If ((TypeOf t Is Shape) Or (t.Tag = "3")) And (t.Tag <> "1") Then
  213.             n = n + 1
  214.             eod = eod + 1
  215.             Select Case t
  216.                 Case Shape_Rectange: elipHnd(n) = CreateRectRgn(t.Left / 15, t.Top / 15, (t.Left + t.Width) / 15, (t.Top + t.Height) / 15)
  217.                 Case Shape_Oval: elipHnd(n) = CreateEllipticRgn(t.Left / 15, t.Top / 15, (t.Left + t.Width) / 15, (t.Top + t.Height) / 15)
  218.                 Case Shape_RndRectange: elipHnd(n) = CreateRoundRectRgn(t.Left / 15, t.Top / 15, (t.Left + t.Width) / 15, (t.Top + t.Height) / 15, 10, 10)
  219.              End Select
  220.             If (eod = 2) And (n = 1) Then
  221.                 CombineRgn elipHnd(0), elipHnd(1), elipHnd(0), RGN_OR
  222.                 eod = 0
  223.             End If
  224.             If (eod = 1) And (n <> 0) Then
  225.                 CombineRgn elipHnd(n - 2), elipHnd(n - 1), elipHnd(n), RGN_OR
  226.                 CombineRgn elipHnd(0), elipHnd(0), elipHnd(n - 2), RGN_OR
  227.                 eod = 0
  228.             End If
  229.         End If
  230.     Next t
  231.     SetWindowRgn Me.hwnd, elipHnd(0), True
  232.     '   ^ the best bit! This does the hard work and...
  233.     '     ...creates the regions
  234. End Sub
  235. Private Sub AlwaysOnTop(TOF As Boolean)
  236.     If TOF = True Then
  237.         SetWindowPos hwnd, conHwndTopmost, 0, 0, 0, 0, 3
  238.         '   ^ Turn on the TopMost attribute.
  239.     Else
  240.         SetWindowPos hwnd, conHwndNoTopmost, 0, 0, 0, 0, 3
  241.         '   ^ Turn off the TopMost attribute.
  242.     End If
  243. End Sub
  244. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  245.     If Button = 1 Then
  246.         Me.MousePointer = vbSizePointer
  247.         Dp.X = X
  248.         Dp.Y = Y
  249.         DoDrag = True
  250.     Else
  251.         Unload Me
  252.     End If
  253.     '   ^ the dragging bit!
  254. End Sub
  255. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  256.     If DoDrag Then Me.Move Me.Left + X - Dp.X, Me.Top + Y - Dp.Y
  257.     '   ^ ...and more dragging...
  258. End Sub
  259. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  260.     DoDrag = False
  261.     Me.MousePointer = Default
  262.     '   ^ the last of the dragging bit!
  263. End Sub
  264. Private Sub Timer1_Timer()
  265.     Me.Top = Me.Top + UD
  266.     Me.Left = Me.Left + LR
  267.     '   ^ move the teddy bare!
  268.     If (Me.Top <= 0) Or (Me.Top + Me.Height >= Screen.Height) Then
  269.         UD = UD - (UD * 2)
  270.         Beep
  271.     End If
  272.     '   ^ bounce if on left or right edge
  273.     If (Me.Left <= 0) Or (Me.Left + Me.Width >= Screen.Width) Then
  274.         LR = LR - (LR * 2)
  275.         Beep
  276.     End If
  277.     '   ^ bounce if on top or bottem edge
  278. End Sub
  279.